The X-Philes (2nd Revision)/The X-Philes Number 1 (1995).iso/xphiles/hp48_1/partial.fra

Text File | 1995-03-23 | 5KB | 281 lines

Subject: Partial Fractions in the form y(x)=f(x)/g(x)

                       Partial Fractions
                       -----------------

This is a program that will part a fraction of the form y(x)=f(x)/g(x)
into partial fractions. f(x) and g(x) must satisfy the following
conditions:

f(x) and g(x) are polynomials with real coefficients. The degree of f(x)
is lower than that of g(x).
The independant variable must always be X.

The following factors may be used in the denominator:
 X
 X^n
 (X+-a)
 (X+-a)^n
 (X^2+-a)
 (X^2+-a)^n
 (X^2+-a*X+-b)
 (X^2+-a*X+-b)^n
where n=positive integer
      a=b=real

Usage:
------
Put fraction on stack and run 'DEL'. The result will be returned to
level 1 and execution time to level 2.

The program will ignore coefficients smaller than 'KZ'. Default value
is 0.00001, and may be changed if very small coefficients are to be
expected. In that case, you should use 'EXDEL'  which calls an iterative
routine using the RSD-function when solving the matrix.

How it works:
-------------
It insert values and then solves the resultant matrix. A long story...


Examples:
---------
Try these to check the program:

  '(X^3-7*X^2+14*X-9)/((X-1)^2*(X-2)^3)'

  '(X^4*(2*X+1)+X*(7*X^2+14*X+28))/(X^4*(X^2+2*X+4))'


-----------------------CUT---------------------------------------------
%%HP: T(3)A(D)F(.);
DIR
  DEL
    \<< \-> b
      \<< CLEAR TICKS
-3 CF 'X' PURGE { }
b
        IF OBJ\->
\->STR "/" \=/
        THEN CLEAR
"Error" KILL
        ELSE DROP
SWAP DROP
        END
        WHILE DUP
          IFERR
OBJ\->
          THEN ""
""
          ELSE SWAP
DROP
          END \->STR
"*" ==
        REPEAT ROT
DROP ROT + SWAP
        END DROP2 +
{ } { } 3 PICK 1
OVER SIZE
        FOR x x GET
          CASE DUP
'X' SAME
            THEN
ROT SWAP + SWAP 0 +
            END DUP
OBJ\-> SWAP DROP \->STR
"^" \=/
            THEN
DROP2
              IF
DUP SIZE 4 >
              THEN
FAC
IF
THEN 4 ROLL + +
SWAP { 0 0 } SWAP +
ELSE ROT SWAP +
SWAP 1 +
END
              ELSE
ROT + SWAP 0 SWAP +
              END
            END ROT
DROP SWAP
            IF DUP
SIZE 4 >
            THEN
FAC
            ELSE 0
            END
            IF
            THEN 3
PICK SYNK 5 ROLL +
4 ROLLD 5 ROLL + 4
ROLLD SWAP SYNK ROT
+ SWAP ROT + SWAP
            ELSE
SWAP SYNK ROT +
SWAP ROT + SWAP
            END
          END 3
PICK
        NEXT DROP
ROT DROP DUP SIZE
OVER OBJ\-> 1 SWAP
        START +
        NEXT DUP
        \<<
1.46459188 \-> a v
          \<< { } 1 a
            START
'v' INCR +
            NEXT
          \>>
        \>> EVAL 's1'
PURGE b MATR
      \>>
    \>>
  EXDEL
    \<< 5 SF DEL
    \>>
  HELP
    \<<
"Partial Fractions V3.1

written by G. A. M. D.


Press any key...
"
1 DISP
      DO
      UNTIL KEY
      END DROP
"Allowed factors in
denominator:
X , X^n , (X\177a)
(X\177a)^n , (X^2\177a)
(X^2\177a)^n, (X^2\177a*X\177b)
(X^2\177a*X\177b)^n
    "
1 DISP
      DO
      UNTIL KEY
      END DROP
    \>>
  CST { DEL EXDEL
HELP }
  SYNK
    \<< \-> u p
      \<< { } 1 p
        FOR x u x ^
+
        NEXT
        IF u SIZE 3
>
        THEN 1
        ELSE 0
        END { } 1 p
        START OVER
+
        NEXT SWAP
DROP
      \>>
    \>>
  MATR
    \<< \-> r t z v b
      \<< 1 z
        FOR x v x
GET 'X' STO b EVAL
        NEXT z
\->ARRY 1 z
        FOR e v e
GET 'X' STO 1 r
SIZE
          FOR c r c
GET t c GET
            \<< DUP
EVAL INV SWAP EVAL
INV X *
            \>>
            \<< EVAL
INV
            \>> IFTE
          NEXT
        NEXT { z z
} \->ARRY 5 FS?C
        \<< EXACT
        \>>
        \<< /
        \>> IFTE 'X'
PURGE ARRY\-> 1 GET
\->LIST { } SWAP 1
OVER SIZE
        FOR x DUP
          IF x GET
ABS KZ <
          THEN SWAP
0 +
          ELSE SWAP
OVER x GET 3 RND +
          END SWAP
        NEXT DROP 1
1 r SIZE
        FOR x t x
GET
          \<< DUP2
GET SWAP 1 + SWAP 3
PICK 3 PICK GET 'X'
* + r x GET / EVAL
3 ROLLD 1 +
          \>>
          \<< DUP2
GET r x GET / EVAL
3 ROLLD 1 +
          \>> IFTE
        NEXT DROP2
DEPTH 2 - 1 SWAP
        START +
        NEXT TICKS
ROT - B\->R 8192 / 2
RND SWAP
      \>>
    \>>
  FAC
    \<< \-> a
      \<< "'" a 'X'
QUAD \->STR 4 OVER
SIZE SUB + STR\-> DUP
1 's1' STO EVAL
SWAP 's1' SNEG EVAL
        IF DUP TYPE
        THEN DROP2
a 0
        ELSE 'X'
SWAP - SWAP 'X'
SWAP - 1
        END
      \>>
    \>>
  KZ .00001
  EXACT
    \<< DUP2 /
      DO \-> b a z
        \<< b a b a z
RSD a / z + z
        \>>
      UNTIL OVER ==
      END 3 ROLLD
DROP2
    \>>
END
-------------------------CUT---------------------------------------------


Geir A. M. Drange
BIH, Bergen, Norway

INTERNET:   [e-mail]